perm filename DRIVE3[AI,JMC] blob sn#005442 filedate 1971-08-13 generic text, type T, neo UTF8
TITLE DRIVE

	;DEFS FOR DIRVE PROGRAM

;ACS

I=7
P=17
FL=0
T1=1
T2=2
T3=3
DEST=15
MOVER=16

;BITS

PRWP==4
AUTO==4		;LEFT HALF
WPMD==2		;LEFT HALF
WP2M==10
TRCMD==100
TIMR==4000

;A WHOLE BUNCH OF EXTERNALS

EXTERNAL COM,NXTSET,SETBTB,INWD,INMOV,GOMOV,CKCK,COLOR,UNMOV,JOBFF,ALPHA
EXTERNAL BCOUNT,BEFFT,BETA,ENPSQ,EPMOVER,JMOVE,LEVEL,LLIM,LOC,MKMOV
EXTERNAL NUMIN,OCC,PRNTM1,PRNTMV,PUTCH,ULIM,WCOUNT,WEFFT,PTBD
EXTERNAL CKLEV,PCTB,LM,KIND,WALLP2,STWDP,NMV
EXTERNAL ENDLV,PROMVL,CPVL,DCKVL,SCKVL,ATHVL,THRVL,DTHRVL,OUTCKL,POSMK,MAXLV

;THIS IS THE DRIVING PROGRAM FOR CHESS

STPT:	CALLI
	INIT 1,15	;GRAB DISPLAY IF POSSIBLE
	SIXBIT /DIS/
	0
	JRST NODIS
	MOVEI T1,1
	FSC T1,0
	CAIE T1,1
	OUTPUT 1,COM	;START IT IF AVAILABLE
NODIS:	INIT 2,1
	SIXBIT /TTY/
	XWD 0,IBUF	;ONLY INPUT (OUTPUT IN DDT SUBMODE OR AS DEV 3)
	CALLI 12	;GIV UP IF NO TTY
	INBUF 2,2
	MOVE P,[XWD -2000,PDL1]	;SET UP PUSHDOWN LIST
	PUSHJ P,NXTSET	;SET UP TABLES FOR PUTCH (MACROS ARE TOO SLOW)
	PUSHJ P,SETBTB
	MOVEI FL,0	;START OUT WITH ALL FLAGS OFF
	SETOM GMSTR	;BLANK GAME STORAGE AREA
	MOVE T1,[XWD GMSTR,GMSTR+1]
	BLT T1,GMSTR+427
	MOVEI T1,REE
	MOVEM T1,JOBREN

EXTERNAL JOBREN

	JRST STRTUP
INLP:	PUSHJ P,INWD	;READ AN IDENTIFIER
	HRLZI T3,-NVAR
	CAMN T1,@VTB(T3)
	JRST VARHD
	AOBJN T3,.-2
	HRLZI T3,-NCOM	;SET TO SEARCH TABLE FOR A COMMAND
INLP1:	CAMN T1,@CMTB(T3)
	JRST @CMDSB(T3)	;DISPATCH
	AOBJN T3,INLP1
	PUSHJ P,INMOV	;MUST BE A MOVE
	JRST QMKR	;ERROR RETURN FROM INMOV
	AOS T2,MVSVPT#	;FIND THAT MOVE POINTER (WHERE TO SAVE NEXT ONE)
	MOVEM MOVER,MVSV-1(T2)	;MOVE RETURNED IN T1
	JSR GOMOV	;MAKE IT
	PUSHJ P,CKCK	;IS HE IN CHECK
	JRST INCK	;YES
	MOVEI T1,20	;INVERT COLOR
	XORM T1,COLOR
	TLNN FL,AUTO	;SHOULD PROGRAM PLAY NOW?
	JRST INLP	;NO, GO LOOK AGAIN
	JRST PLWT+1	;YES, MAKE A MOVE
INCK:	JSR UNMOV	;TAKE BACK THAT MOVE
	MOVEI T1,[ASCIZ /
ILL
/]
	CALLI T1,3	;PRINT IT
	SOS T2,MVSVPT	;THE POINTER AGAIN
	SETOM MVSV(T2)	;ZERO IT
	JRST INLP	;AND LOOK AGAIN
;TABLE OF COMMANDS AND DISPATCH ADDRESSES

	DEFINE ASKR (A)
<IRP A <EXP [ASCIZ \A\]>>

CMTB:	ASKR <ST,ON,OFF,GO,PB,PW,PG,BD,←,MV,MVO,ADD,MW,MB,EPS,CS,RET,WALLP,NWALL,TRACE,UNTRACE,DDT,TIME,UNTIM>
	ASKR <NMV>
NCOM=.-CMTB
CMDSB:	EXP STRTUP,TNONWP,TNOFWP,RSTBD,PLBK,PLWT,PTGM,PTBD2
	EXP STBD,MVIT,RMVIT,ADDIT,MVWT,MVBLK,EPS,CS,RETRC
	EXP WALLP,WALOF,TRACE,UNTRACE,DDTR,TIMER,UNTMR,NMVST

VTB:	ASKR <ENDLV,PROMVL,CPVL,DCKVL,SCKVL,ATHVL,THRVL,DTHRVL>
	ASKR <OUTCKL,POSMK,MAXLV,CLV1,BETA,ALPHA>
NVAR=.-VTB

VTB2:	EXP ENDLV,PROMVL,CPVL,DCKVL,SCKVL,ATHVL,THRVL,DTHRVL
	EXP OUTCKL,POSMK,MAXLV,CLV1,MBETA,MALPHA,0

NMVST:	PUSHJ P,NUMIN
	SKIPLE T1
	CAIL T1,30
	JRST QMKR
	ADDI T1,NMV-1
	MOVEM T1,VTB2+NVAR
	MOVEI T3,NVAR
VARHD:	CAIE T2,"="
	JRST INVAR
	MOVE T2,@VTB2(T3)
	PUSHJ P,ONUM2
	MOVEI T2,[ASCIZ /
/]
	CALLI T2,3
	JRST INLP
INVAR:	PUSHJ P,NUMIN
	MOVEM T1,@VTB2(T3)
	JRST INLP

ONUM2:	JUMPGE T2,ONM2A
	MOVEI T3,[ASCIZ /-/]
	CALLI T3,3
	MOVNS T2
ONM2A:	IDIVI T2,10
	ADDI T3,"0"
	HRLM T3,(P)
	SKIPE T2
	PUSHJ P,ONM2A
	HLRZ T3,(P)
	ROT T3,-7
	MOVEM T3,NEGSV#
	MOVEI T2,NEGSV
	CALLI T2,3
	POPJ P,


TIMER:	TRO FL,TIMR
	JRST INLP

UNTMR:	TRZ FL,TIMR
	JRST INLP

PTBD2:	PUSHJ P,PTBD
	JRST INLP

STRTUP:	PUSHJ P,STRT1
	JRST INLP	;RESET BOARD TO INITIAL POS

STRT1:	SETOM MVSV	;AND GAME STORAGE
	MOVE T1,[XWD MVSV,MVSV+1]
	BLT T1,MVSV+277	
	SETZM MVSVPT	;READY TO STORE GAME
STRT2:	SETOM LOC	;ZERO OUT TABLES IN PUTCH
	MOVE T1,[XWD LOC,LOC+1]
	BLT T1,JMOVE+3777
	SETOM EPMOVER
	SETOM ENPSQ
	SETZM BCOUNT	;PIECE COUNTS
	SETZM WCOUNT
	SETZM COLOR	;WHITE TO MOVE
	HRLZI T1,-10	;RESETING TYPE INFO
RSTYP:	MOVEI T2,3
	HRLM T2,LM+10(T1)	;LM
	HRLM T2,LM+30(T1)	;FOR BOTH COLORS
	SETZM KIND+10(T1)	;RESET KIND
	SETZM KIND+30(T1)	;FOR BOTH COLORS
	MOVEI T2,354021		;WHITE PAWN
	MOVE T3,PCTB+10(T1)	;LOCATION
	HRLM T2,1(T3)
	MOVEI T2,273
	HRLM T2,2(T3)
	MOVEI T2,354023
	HRLM T2,61(T3)	;BLACK PAWN
	MOVEI T2,400273
	HRLM T2,62(T3)
	AOBJN T1,RSTYP
	HRLZI T1,-40	;READY TO SET PIECES
SET1:	HRRZ DEST,SETB(T1)
	HLRZ MOVER,SETB(T1)
	PUSH P,T1	;SAVE THIS SINCE PUTCH WILL WIPE IT OUT
	PUSHJ P,PUTCH	;PUT THAT PIECE THERE
	POP P,T1
	AOBJN T1,SET1
	POP P,T1	;GET RETURN ADDRESS
	MOVE P,[XWD -2000,PDL1]
	MOVEI FL,0	;FLAG REGISTER
	JRST (T1)	;RETURN
SETB:	X=0
	REPEAT 20,<XWD X,X
	X=X+1>
	X=20
	REPEAT 10,<XWD X,X+50
	X=X+1>
	X=30
	REPEAT 10,<XWD X,X+30
	X=X+1>

EXTERNAL JOBDDT,JOBOPC

DDTR:	SKIPN JOBDDT
	JRST QMKR
	JRST @JOBDDT

REE:	SETOM QFLG#
	JRST @JOBOPC

INTERNAL QFLG
;TRACE AND FULL WALLPAPER MODE

WALOF:	TLZA FL,WP2M
WALLP:	TLO FL,WP2M
	JRST INLP

TRACE:	TLO FL,TRCMD
	JRST TNONWP	;GET LINE PRINTER OR TTY
UNTRAC:	TLZ FL,TRCMD
	JRST TNOFWP	;RELEASE DEVICE 3

;HERE IS THE SECTION WHICH TURNS ON WALLPAPER MODE

TNONWP:	TLOE FL,WPMD	;TURN ON WALLP BIT
	JRST INLP	;ALREADY ON
	MOVE T1,JOBFF	;SAVE THIS
	MOVEM T1,SVJOBF#
	CAIE T2,"↑"	;IF NEXT A ↑ THEN LPT DESIRED
	JRST SETTY	;ELSE USE TTY
	MOVE T1,[SIXBIT /LPT/]
TN1:	MOVEM T1,INITR	;SET UP DEVICE TO INIT
	INIT 3,1
INITR:	SIXBIT /LPT/	;TO START WITH
	XWD OBUF,	;ONLY OUTPUT
	SKIPA		;IF NOT AVAIL USE TTY ANYWAY
	JRST INLP	;GET NEXT COMMAND
SETTY:	MOVE T1,[SIXBIT /TTY/]
	JRST TN1	;AND GO SET UP

;NOW THE ROUTINE TO TURN IT OFF

TNOFWP:	TLZN FL,WPMD	;TURN OFF FLAG
	JRST INLP	;NOTHING TO DO
	RELEAS 3,0	;AND RELEASE DEVICE
	MOVE T1,SVJOBF	;RESTORE
	MOVEM T1,JOBFF
	JRST INLP

;THE ROUTINE TO PRINT OUT THE GAME TO DATE

PTGM:	PUSHJ P,STRT2	;GOES BACK TO START AND MAKES EACH MOVE AS IT PRINTS IT
	MOVEI T3,0	;START WITH MOVE 0
PTGM1:	SETZM COLOR	;AND WHITE
	SKIPGE MOVER,MVSV(T3)	;AT END?
	JRST FCR	;ONE LAST RETURN
	MOVEM T3,SVT3#	;SAVE IT FROM PUTCH
	PUSHJ P,PRNTM1	;PRINT THE MOVE WITH NO LINE FEED
	JSR GOMOV	;MAKE THE MOVE
	MOVEI T1,[ASCIZ /	/]	;PRINT A TAB
	CALLI T1,3
	AOS T3,SVT3
	MOVEI T1,20
	MOVEM T1,COLOR	;BLACK NEXT
	SKIPGE MOVER,MVSV(T3)
	JRST FCR
	MOVEM T3,SVT3	;SAVE AGAIN
	PUSHJ P,PRNTMV	;WITH CRLF THIS TIME
	JSR GOMOV
	MOVE T3,SVT3	;BACK ONCE MORE
	AOJA T3,PTGM1
FCR:	MOVEI T1,[ASCIZ /
/]
	CALLI T1,3
	JRST INLP
;THE CODE TO SAVE THE CURRENT GAME POSITION

STBD:	PUSHJ P,INWD
	CAIL T1,"A"	;POSSIBLE SAVES ARE A-H
	CAILE T1,"H"
	JRST QMKR	;PRINT A ?
	MOVE T1,GMSTR-"A"(T1)	;GET POINTER TO THE PROPER LOCATION
	MOVE T2,ENPSQ	;SAVE THIS DATA
	MOVEM T2,(T1)
	MOVE T2,EPMOVER	;AND THIS
	MOVEM T2,1(T1)
	MOVE T2,FL	;AND THE CASTLING INFO
	TDZ T2,[XWD 777717,777717]
	MOVEM T2,2(T1)
	ADDI T1,3	;NOW FOR THE LOCATIONS OF PIECES
	HRLI T2,LOC	;BLT LOC TO THERE
	HRR T2,T1	;DEST
	BLT T2,37(T1)	;40 WORDS
	JRST INLP	;NEXT COMMAND

;HERE IS THE ? PRINTER CALLED BY LOTS OF PEOPLE

QMKR:	MOVEI T1,[ASCIZ /
?
/]
	CALLI T1,3
	JRST INLP
;HERE IS WHERE WE RETURN A GAME TO A PREVIOUS STATE

RSTBD:	PUSHJ P,INWD	;GET THE GAME POS. TO RESTORE
	CAIL T1,"A"
	CAILE T1,"H"
	JRST QMKR
	MOVE T1,GMSTR-"A"(T1)
	MOVE T2,(T1)
	MOVEM T2,ENPSQ
	MOVE T2,1(T1)
	MOVEM T2,EPMOVER
	TDZ FL,[XWD 60,60]	;TURN OFF THOSE CASTELING BITS
	IOR FL,2(T1)	;PUT IN THE ONES TO RESTORE
	ADDI T1,3
	SETOM LOC	;RESET TABLES
	MOVE T2,[XWD LOC,LOC+1]
	BLT T2,JMOVE+3777
	SETZM BCOUNT
	SETZM WCOUNT
	MOVEI T2,MVSV
	MOVEM T2,MVSVPT
	MOVE T2,[XWD MVSV,MVSV+1]
	SETOM MVSV
	BLT T2,MVSV+277	;RELEASE SAVED MOVES
	HRLI T1,-40
RSTLP:	MOVE DEST,(T1)	;WHERE TO GO
	HLRE MOVER,T1	;SEE THE MAGIC
	ADDI MOVER,40	;MAKES IT GO  0-37
	PUSH P,T1	;SAVE IT
	PUSHJ P,PUTCH
	POP P,T1
	AOBJN T1,RSTLP
	JRST INLP	;ALL SET
;NOW THE ROUTINE TO MAKE A MOVE FOR THE MACHINE

PLBK:	MOVEI T1,20	;A MOVE FOR BLACK
	MOVEM T1,COLOR
	SKIPA
PLWT:	SETZM COLOR	;THE SECOND ENTRY POINT
	TLO FL,AUTO	;SET FOR AUTO PLAY
	SETZM QFLG
	SETOM LEVEL	;LEVEL OF -1 SINCE MKMOVE INCREMENTS
	SETZM BEFFT	;EFFORT FOR BLACK
	SETZM WEFFT	;AND FOR WHITE
	MOVEI T1,0
	CALLI T1,27	;GET RUNTIME
	MOVEM T1,SVRUNT#
	MOVE T1,MBETA
	MOVEM T1,BETA	;SET BETA
	MOVE T1,MALPHA
	MOVEM T1,ALPHA	;FOR ALPHA
	MOVE T1,CLV1
	MOVEM T1,CKLEV	;CHECK LEVEL
	MOVEI T1,MVTB+3777	;SET UP ULIM, LLIM
	MOVEM T1,ULIM
	MOVEM T1,LLIM
	MOVE T1,[POINT 36,PVAR]
	MOVEM T1,STWD
	SETZM TMPUT#
	SETZM VCTR#
	SETZM FCTR#
	SETZM V2CTR#
	SETZM FTMR#
	SETZM VTMR#
	SETZM VCTMR#
	SETZM V2TMR#
	SETZM TMGM#
	SETZM TMMP#
	SETZM TMPMP#
	SETZM PTCTR#
	SETZM GMCTR#
	SETZM MPCTR#
	SETZM MPPCTR#
	TLNN FL,WPMD
	TLNN FL,WP2M	;FULL WALLPAPER?
	JRST NOWP
	MOVE T1,JOBFF
	MOVEM T1,SVJF#
	INIT 3,1
	SIXBIT /LPT/
	XWD OBUF,
	JRST .-3
	OUTPUT 3,0
NOWP:	TLNN FL,WP2M+WPMD
	JRST NOWP2Z
	MOVEI T3,10
	MOVEM T3,RADIX
	TRO FL,PRWP
	HRLZI I,-NVAR
PRPAR:	MOVE T2,VTB(I)
	PUSHJ P,TXTOU1
	MOVEI T2,[ASCIZ /= /]
	PUSHJ P,TXTOU1
	MOVE T1,@VTB2(I)
	PUSHJ P,NOUT
	MOVEI T2,[ASCIZ /
/]
	PUSHJ P,TXTOU1
	AOBJN I,PRPAR
	MOVEI T3,12
	MOVEM T3,RADIX
	PUSHJ P,PTBD
	TRZ FL,PRWP
NOWP2Z:	PUSHJ P,MKMOV	;MAKE THE MOVE
	TLNN FL,WP2M
	JRST NOWP2
	MOVE I,STWDP
	MOVEM I,STWD
	MOVEI I,PVAR
	PUSHJ P,WALLP2
	TLNE FL,WPMD
	JRST NOWP2
	MOVE T2,SVJF
	MOVEM T2,JOBFF
	RELEAS 3,0
NOWP2:	SKIPE QFLG
	JRST INLP
	MOVE T2,MVSVPT	;WHERE TO SAVE MOVE
	SKIPN MOVER,PVAR	;GET CHOSEN MOVE
	JRST CKMT	;CHECKMATE IF NO MOVE
	MOVEM MOVER,MVSV(T2)	;SAVE IT
	PUSHJ P,PRNTMV	;AND LET PLAY KNOW WHAT IT IS
	JSR GOMOV	;MAKE THE MOVE
	AOS MVSVPT	;INDEX MOVE POINTER
	PUSHJ P,CKPT	;SEE IF HE IS IN CHECK AND SAY SO
	MOVEI T1,20	;INVERT COLOR
	XORM T1,COLOR
	JRST INLP
CKMT:	MOVEI MOVER,[ASCIZ /
STALEMATE
/]
	PUSHJ P,CKCK
	MOVEI MOVER,[ASCIZ /
CHECKMATE
/]
	CALLI MOVER,3
	JRST INLP	;GO GET MORE COMMANDS

CKPT:	PUSH P,COLOR	;PRINT OUT CHECK IF MOVES CHECKS
	MOVEI T1,20	;MUST LOOK FOR CHECK ON HIM
	XORM T1,COLOR
	MOVEI MOVER,[ASCIZ /CHECK
/]
	PUSHJ P,CKCK	;IN CHECK?
	CALLI MOVER,3	;YES, PRINT
	POP P,COLOR	;RETORE
	POPJ P,
CLV1:	4
MBETA:	XWD 200000,0
MALPHA:	XWD 600000,0
RADIX:	12
INTERNAL RADIX,VCTR,FCTR,V2CTR,SVRUNT
EXTERNAL NOUT,TXTOU1
;HERE IS THE ROUTINE WHICH ALLOWS AN ILLEGAL MOVE TO BE MADE
;FORMAT IS N1-N2 MOVES PIECE FORM SQN1 TO SQN2

MVIT:	PUSHJ P,NUMIN	;GET A NUMBER
	CAILE T1,77	;MUST BE NO BIGGER THAN THIS (ONLY 77 OCTAL SQS)
	JRST QMKR
	MOVE T3,T1	;HANG ON TO IT
	PUSHJ P,NUMIN	;GET ANOTHER
	CAILE T1,77
	JRST QMKR
	SKIPGE MOVER,OCC(T3)	;GET THE PERSON THERE
	JRST QMKR	;NO PIECE THERE ERROR
	SKIPL OCC(T1)	;IS THERE SOMEONE AT DEST?
	JRST QMKR	;ANOTHER ERROR
	MOVE DEST,T1	;SET DESTINATION
	PUSHJ P,PUTCH	;MOVE
	JRST INLP

;THIS IS TO REMOVE A PIECE FROM THE BOARD GIVE NUMBER OF SQUARE IT'S ON

RMVIT:	PUSHJ P,NUMIN
	CAILE T1,77
	JRST QMKR	;NO SUCH SQUARE
	SKIPGE MOVER,OCC(T1)	;SOMEONE THERE?
	JRST QMKR	;NO, ERROR
	MOVNI DEST,1	;OFF BOARD
	PUSHJ P,PUTCH
	JRST INLP
;THE ROUTINE TO PUT A PIECE ON THE BOARD
;TAKES N1-N2 N1 IS PIECE NUMBER N2 THA DEST SQUARE

ADDIT:	PUSHJ P,NUMIN
	CAILE T1,37	;BIGEST PIECE IS 37
	JRST QMKR
	MOVE T3,T1	;SAVE IT
	PUSHJ P,NUMIN
	CAILE T1,77	;SQUARE
	JRST QMKR
	SKIPL OCC(T1)	;SOMEONE ALREADY THERE?
	JRST QMKR
	SKIPL LOC(T3)	;IS HE ALREADY ON BOARD?
	JRST QMKR	;ERROR
	MOVE DEST,T1
	MOVE MOVER,T3
	PUSHJ P,PUTCH
	JRST INLP

;SET UP TO LET WHITE MOVE

MVWT:	TLZ FL,AUTO	;TAKE IT OUT OF AUTO PLAY
	SETZM COLOR
	JRST INLP

;SAME FOR BLACK

MVBLK:	TLZ FL,AUTO
	MOVEI T1,20
	MOVEM T1,COLOR
	JRST INLP
;	ALLOW ENPAS TO BE SET TAKE NUMBER OF PIECE TO BE SET AS
;	CAPTUREABLE ENPAS

EPS:	PUSHJ P,NUMIN
	CAIG T1,37	;TOO BIG?
	TRNN T1,10	;ALL PAWN HAVE THIS BIT ON
	JRST QMKR
	MOVEM T1,EPMOVER	;SET IT
	ADDI T1,10	;GET SQUARE
	CAILE T1,27	;IS SO IT WAS BLACK
	ADDI T1,10	;SO MAKE IT CORRECT SQUARE
	MOVEM T2,ENPSQ	;SAVE SQUARE
	JRST INLP

;SET CASTLING BITS TAKES NUMBER-NUMBER FIRST IS FOR  QUEEN SIDE SECOND FOR
;KING. IF BIT 1 ON NO GOOD FOR WHITE BIT 2 NO GOOD FOR BLACK

CS:	PUSHJ P,NUMIN	;GET NUMBER
	CAILE T1,3
	JRST QMKR
	LSH T1,4
	TLZ FL,60
	TSO	FL,T1	;PUT IN BITS
	PUSHJ P,NUMIN
	CAILE T1,3
	JRST QMKR
	LSH T1,4
	TRZ FL,60
	IOR FL,T1
	JRST INLP


;THIS CODE RETRACTS A MOVE

RETRC:	SKIPG T1,MVSVPT
	JRST QMKR	;NO MOVES TO RETRACT
	SETOM MVSV-1(T1)	;REMOVE IT
	SOS MVSVPT	;RESET POINTER
	JSR UNMOV	;RETRACT
	JRST INLP	;CONTINUE

;TABLES

IBUF:	BLOCK 3
OBUF:	BLOCK 3
GMSTR:	BLOCK 430	;STORE POSITIONS
MVSV:	BLOCK 300	;STORE MOVES IN CURRENT GAME
PDL1:	BLOCK 2001	;PUSHDOWN LIST
STWD:	POINT 36,PVAR	;POINTER TO PRINC VAR
PVAR:	BLOCK 100	;NEVER GO MORE THAN 30 LEVELS DEEP (I HOPE)
MVTB:	BLOCK 4000

;THE INTERNALS

INTERNAL STWD,IBUF,INLP,OBUF,MVTB,STPT,TMPUT,TMGM,TMMP,TMPMP,PTCTR
INTERNAL GMCTR,MPCTR,MPPCTR,FTMR,VTMR,VCTMR,V2TMR

END STPT